home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 041-050 / amok44 / m2ced / txt / errormsg.mod < prev    next >
Text File  |  1993-11-04  |  3KB  |  168 lines
  1. (**********************************************************************
  2.  
  3.     :Program.    ErrorMsg.mod
  4.     :Contents.   Read all errormessages from M2:Fehlermeldungen
  5.     :Author.     Steffen Reith
  6.     :Address.    Hessenstr. 64, D-8700 Würzburg
  7.     :Copyright.  Shareware
  8.     :Language.   Modula-2
  9.     :Translator. M2Amiga A+L V3.2d
  10.     :Imports.    Msg
  11.     :History.    V1.0  14.June 1990
  12.     :History.    V1.1  24.June 1990 ( Better Memory Usage )
  13.  
  14. **********************************************************************)
  15. IMPLEMENTATION MODULE ErrorMsg;
  16.  
  17. FROM Dos     IMPORT Open,Close,FileHandlePtr,readOnly,Seek,Read,beginning,
  18.                     current;
  19. FROM SYSTEM  IMPORT ADR,ADDRESS,BYTE;
  20. FROM Heap    IMPORT Allocate,Deallocate;
  21. FROM Msg     IMPORT EndRequest;
  22.  
  23. CONST ErrName='M2:Fehler-Meldungen'; (* Nur deutsche Version *)
  24.  
  25. TYPE NodePtr=POINTER TO Node;
  26.      Node=RECORD
  27.            No:INTEGER;
  28.            Entry:ADDRESS;
  29.            NextNode:NodePtr
  30.           END;
  31.  
  32. VAR CurrentPtr:NodePtr;
  33.  
  34. PROCEDURE KillList(Root:NodePtr);
  35.  
  36. VAR Help:NodePtr;
  37.  
  38. BEGIN
  39.  WHILE Root#NIL DO
  40.   Help:=Root;
  41.   Root:=Root^.NextNode;
  42.   Deallocate(Help^.Entry);
  43.   Deallocate(ADDRESS(Help))
  44.  END
  45. END KillList;
  46.  
  47. PROCEDURE ReadLongInt(File:FileHandlePtr):LONGINT;
  48.  
  49. VAR Value,Dummy:LONGINT;
  50.  
  51. BEGIN
  52.  Dummy:=Read(File,ADR(Value),SIZE(Value));
  53.  RETURN(Value)
  54. END ReadLongInt;
  55.  
  56. PROCEDURE ReadErrorNumber(File:FileHandlePtr):INTEGER;
  57.  
  58. VAR Dummy:LONGINT;
  59.     Value:INTEGER;
  60.  
  61. BEGIN
  62.  Dummy:=Read(File,ADR(Value),SIZE(Value));
  63.  RETURN(Value)
  64. END ReadErrorNumber;
  65.  
  66. PROCEDURE ReadString(File:FileHandlePtr;Next:LONGINT;VAR Text:ADDRESS);
  67.  
  68. VAR Dummy,Aktuell,Laenge:LONGINT;
  69.  
  70. BEGIN
  71.   Aktuell:=Seek(File,0,current);
  72.   Laenge:=Next-Aktuell;
  73.   Allocate(Text,Laenge);
  74.   IF Text=NIL THEN
  75.    EndRequest('Nicht genug Speicher fuer Fehlermeldungen')
  76.   END;
  77.   Dummy:=Read(File,Text,Laenge)
  78. END ReadString;
  79.  
  80. PROCEDURE ReadList(VAR Root:NodePtr);
  81.  
  82. VAR File:FileHandlePtr;
  83.     Help:NodePtr;
  84.     Ptr:ADDRESS;
  85.     Next,Dummy:LONGINT;
  86.     Meldung:String;
  87.     ErrorNo:INTEGER;
  88.  
  89. BEGIN
  90.  File:=NIL;
  91.  Root:=NIL;
  92.  File:=Open(ADR(ErrName),readOnly);
  93.  IF File=NIL THEN
  94.   EndRequest('Kann Fehlermeldungsdatei nicht oeffnen')
  95.  END;
  96.  LOOP
  97.   Next:=ReadLongInt(File);
  98.   IF Next=0 THEN EXIT END;
  99.   ErrorNo:=ReadErrorNumber(File);
  100.   ReadString(File,Next,Ptr);
  101.   Allocate(ADDRESS(Help),SIZE(Node));
  102.   IF Help=NIL THEN
  103.    EndRequest('Nicht genug Speicher fuer Errorliste')
  104.   END;
  105.   WITH Help^ DO
  106.    No:=ErrorNo;
  107.    Entry:=Ptr;
  108.    NextNode:=Root
  109.   END;
  110.   Root:=Help;
  111.   Dummy:=Seek(File,Next,beginning)
  112.  END;
  113.  CurrentPtr:=Root; (* Global !! *)
  114.  Close(File)
  115. END ReadList;
  116.  
  117. PROCEDURE NextEntry():NodePtr;
  118.  
  119. BEGIN
  120.  IF CurrentPtr^.NextNode#NIL THEN
  121.   CurrentPtr:=CurrentPtr^.NextNode;
  122.   RETURN CurrentPtr
  123.  ELSE
  124.   RETURN NIL
  125.  END
  126. END NextEntry;
  127.  
  128. PROCEDURE Cp(Ptr:ADDRESS;VAR Text:String);
  129.  
  130. TYPE CharPtr=POINTER TO CHAR;
  131.  
  132. VAR ChPtr:CharPtr;
  133.     i:INTEGER;
  134.  
  135. BEGIN
  136.  i:=0;
  137.  ChPtr:=Ptr;
  138.  WHILE (ChPtr^#CHAR(0)) AND (i<=len) DO
  139.   Text[i]:=ChPtr^;
  140.   INC(i);
  141.   INC(ChPtr,SIZE(ChPtr^))
  142.  END;
  143.  IF i>len THEN
  144.   Text[i-1]:=CHAR(0)
  145.  ELSE
  146.   Text[i]:=CHAR(0)
  147.  END
  148. END Cp;
  149.  
  150. PROCEDURE FindMsg (Root:NodePtr;Nummer:CARDINAL;VAR Msg:String);
  151.  
  152. VAR Help:NodePtr;
  153.  
  154. BEGIN
  155.  CurrentPtr:=Root;
  156.  REPEAT
  157.   Help:=NextEntry();
  158.   IF Help^.No=INTEGER(Nummer) THEN
  159.    Cp(Help^.Entry,Msg);
  160.    RETURN
  161.   END
  162.  UNTIL Help=NIL;
  163.  Msg:=''
  164. END FindMsg;
  165.  
  166. BEGIN
  167. END ErrorMsg.
  168.